Proyecto - Contingencias de Vida II

Librerías e importaciones

source("cod/setup.R")
source("cod/load_database.R")
source("cod/prob_estim.R")

Factor de degradación para estados CAR

La metodología original empezaba a dar problemas con probabilidades negativas a partir de una edad aproximada de 95 años, por lo que se decidió implementar un factor de reducción desde los 90 años para primero, complementar la probabilidad creciente de muerte y además poder arreglar el problema de probabilidades negativas.

Construir las tablas

source("cod/tablas.R")
Males <- tablas(1)
Females <- tablas(2)

Mejora de mortalidades en el tiempo y mejora de transiciones de empeoramiento

source("cod/degradar_mort.R")
source("cod/calculo_anualidades.R")
edad20 <- degradar_mort(20, 1)

Comprobación de mejoras

calculo_acumulado(20, edad20)
##          Able     Mild Moderate   Severe Profound     Dead
## [1,] 47.37206 6.189601 3.146575 2.593122 3.690927 37.00772
edad20sin_m <- lapply(Males, function(x) as.data.frame(x[21:120,]))
calculo_acumulado(20, edad20sin_m)
##          Able     Mild Moderate   Severe Profound     Dead
## [1,] 42.42812 5.499605 2.619834 1.856993 2.063667 45.53178

Hay una clara diferencia entre mejorías de mortalidades

rm(
  add_mort,
  deteriorate,
  degradacion,
  prob,
  readdata,
  red_factor_norm,
  tablas,
  fig,
  edad20sin_m
)

Cálculo de valores presentes

Se puede realizar varios seguros con los resultados de calculo_vp. Nótese que estamos en edad 20

prueba <- calculo_vp(20, edad20, 0.07, 0.03)

# Seguro de vida normal, 100 millones
(prueba[6]*100e6 )/(12*prueba[1])
## [1] 40566.67
# Seguro de vida con anualidades en caso de Severe o Profound, pagando Mild y Moderate
(prueba[6]*100e6 + 12*(1.5e6*prueba[4] + 3e6*prueba[5]))/(12*(prueba[1]+prueba[2]+prueba[3]))
## [1] 131244.9
# Seguro de vida con anualidades pagando 0.25e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.25e6*prueba[2] +
                         0.5e6*prueba[3] +
                         0.75e6*prueba[4] +
                         1e6*prueba[5]))/(12*prueba[1])
## [1] 111971.3
# Seguro de vida con anualidades pagando 0.5e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.5e6*prueba[2] +
                         1e6*prueba[3] +
                         1.5e6*prueba[4] +
                         2e6*prueba[5]))/(12*prueba[1])
## [1] 183375.8

Cálculo de las primas

source("cod/prima.R")
primas_h <- sapply(20:70, function(x) prima(calculo_vp(x, degradar_mort(x, 1), 0.05, 0.03)))
primas_m <- sapply(20:70, function(x) prima(calculo_vp(x, degradar_mort(x, 2), 0.05, 0.03)))
rm(
  edad20, 
  prueba,
  calculo_acumulado
)

Portafolio

Generación del portafolio

Se utiliza una normal para centrar las observaciones en una edad de interés

set.seed(70707)
portfolio <- data.frame(edad = round(rnorm(5000, mean = 45, sd = 6.5)),
                         sexo = round(runif(5000, 1, 2))) %>% 
  arrange(., edad, sexo) %>%
  mutate(id = dense_rank(paste(edad, sexo)))
descripcion <- portfolio %>% count(edad, sexo)

Y se genera la lista de probabilidades

lista <- list()
for(i in 1:length(descripcion$edad)) {
  prob_matrices <- degradar_mort(descripcion$edad[i], descripcion$sexo[i])
  
  # Se acumulan las probabilidades previo a la simulación estocástica
  lista[[i]] <- lapply(prob_matrices, function(df) {
    t(apply(df[, 2:7], 1, cumsum))
  })
}

Prima nivelada

primas_p <- sapply(1:length(descripcion$edad),
                   function(x) calculo_vp(descripcion$edad[x],
                                          degradar_mort(descripcion$edad[x],
                                                        descripcion$sexo[x]),
                                          0.05, 0.03))
nivelada <- primas_p %*% descripcion$n
(nivelada <- prima(nivelada))
## [1] 266612.7
rm(
  degradar_mort,
  red_factor_mort,
  red_factor_rest,
  calculo_vp,
  i,
  primas_p
)

Modelo estocástico

Proyección de primas

Esto es extra, no se piden.

source("cod/proy_prima.R")
t <- proc.time()
proy_prima_data <- proy_prima_par(1000, 0.07, 0.03)
raw <- proy_prima_data
proc.time()-t
##    user  system elapsed 
##    0.04    0.14   34.21

Calculamos la prima estocástica al percentil 99.5

proy_prima_data <- list()
for(i in 1:100){
  proy_prima_data[[i]] <- raw[,,i]
}
proy_prima_data <- sapply(proy_prima_data, function(x) prima(descripcion$n %*% x))
quantile(proy_prima_data, 0.005)
##     0.5% 
## 96788.19

Preparación para modelar estocásticamente

Variables globales

interes <- 0.07
inflacion <- 0.03
edades <- portfolio$edad
rango <- 120 - min(edades)
v <- (1 + inflacion) / (1 + interes)
v_power <- v^(0:rango)
mujeres <- sum(portfolio$sexo == 2)
hombres <- sum(portfolio$sexo == 1)
sexos <- portfolio$sexo == 1
variables <- c("lista",
                "portfolio",
                "sexos",
                "hombres",
                "mujeres",
                "rango",
                "v_power",
                "proyeccion")

Funciones

source("cod/proyecciones.R")

Proyeccion grupal de pagos y vivos

Única

set.seed(1)
t <- proc.time()
prueba <- proyeccion()
proc.time()-t
##    user  system elapsed 
##    1.76    0.02    2.08

Paralelizado

# t <- proc.time()
# proyeccion_data <- proyeccion_par(100, cores = 2)
# proc.time()-t

Resumen estocástico

Esperanza

source("cod/resumen_estoc.R")
# t <- proc.time()
# media <- esperanza(proyeccion_data)
# proc.time()-t

Percentil

# t <- proc.time()
# percent.995 <- perc_0_995(proyeccion_data)
# proc.time()-t

Guardar las proyecciones

# write_xlsx(media, "res/media.xlsx")
# write_xlsx(percent.995, "res/percentil.xlsx")

Leer las proyecciones

media <- list(
  read_xlsx("res/media.xlsx", sheet = 1),
  read_xlsx("res/media.xlsx", sheet = 2),
  read_xlsx("res/media.xlsx", sheet = 3),
  read_xlsx("res/media.xlsx", sheet = 4)
)
percent.995 <- list(
  read_xlsx("res/percentil.xlsx", sheet = 1),
  read_xlsx("res/percentil.xlsx", sheet = 2),
  read_xlsx("res/percentil.xlsx", sheet = 3),
  read_xlsx("res/percentil.xlsx", sheet = 4)
)

Gráficos

Ingresos y egresos

sum(media[[3]][[1]])
## [1] 10846416988
sum(media[[3]][[2]])
## [1] 10364507602
sum(media[[4]][[1]])
## [1] 10838876838
sum(media[[4]][[2]])
## [1] 10530397885
sum(percent.995[[3]][[1]])
## [1] 11059119801
sum(percent.995[[3]][[2]])
## [1] 9262965590
sum(percent.995[[4]][[1]])
## [1] 11059395809
sum(percent.995[[4]][[2]])
## [1] 9459461593